Archive Magazine CD 1995

home *** CD-ROM | disk | FTP | other *** search

/ Archive Magazine CD 1995 / Archive Magazine CD 1995.iso / discs / prog_disc / volume_1 / issue_11 / robbins / maclib / floatops

(.txt)

Wrap

RISC OS BBC BASIC V Source | 1995-06-13 | 21.5 KB | 657 lines

> MACLIB.FloatOps ********************************************************************* * FLOATING POINT INSTRUCTION ASSEMBLY FUNCTION * * * * (C) Copyright K G Robbins 14 June 1988 * * * * This function accepts a floating point instruction as an input * * string and assembles the corresponding instruction word. * * All seven distinguishable instruction formats are recognised. * * * * The function expects a valid assembler pass number in global * * integer variable Pass% * * * * The function destroys static variables I%, J%, S%, T%, Z% * ********************************************************************* flop(Inst$) FPError: FPAssem(-1,""): =0 IF0=0:F1=1:F2=2:F3=3:F4=4:F5=5:F6=6:F7=7 : default float registers. KR0=0:R1=1:R2=2:R3=3:R4=4:R5=5:R6=6:R7=7 : default general registers. 7R8=8:R9=9:R10=10:R11=11:R12=12:R13=13:R14=14:R15=15 JInst$+=" " : add a blank to terminate scan. ********************************************************************* * Here we build the instruction code, with the operation code and * * appropriate operand, precision and rounding references. * ********************************************************************* >S%=1: Deblank<>0 212,"" : scan past leading blanks. Inst$,S%,3) "MVF":I%=&0E008100: Format1 "MNF":I%=&0E108100: Format1 "ABS":I%=&0E208100: Format1 "RND":I%=&0E308100: Format1 "SQT":I%=&0E408100: Format1 "LOG":I%=&0E508100: Format1 "LGN":I%=&0E608100: Format1 "EXP":I%=&0E708100: Format1 "SIN":I%=&0E808100: Format1 "COS":I%=&0E908100: Format1 "TAN":I%=&0EA08100: Format1 "ASN":I%=&0EB08100: Format1 "ACS":I%=&0EC08100: Format1 "ATN":I%=&0ED08100: Format1 "ADF":I%=&0E000100: Format2 "MUF":I%=&0E100100: Format2 "SUF":I%=&0E200100: Format2 "RSF":I%=&0E300100: Format2 "DVF":I%=&0E400100: Format2 "RDF":I%=&0E500100: Format2 "POW":I%=&0E600100: Format2 "RPW":I%=&0E700100: Format2 "RMF":I%=&0E800100: Format2 "FML":I%=&0E900100: Format2 "FDV":I%=&0EA00100: Format2 "FRD":I%=&0EB00100: Format2 "POL":I%=&0EC00100: Format2 "LDF":I%=&0C100100: Format3 "STF":I%=&0C000100: Format3 "CMF":I%=&0E90F110: Format4 "CNF":I%=&0EB0F110: Format4 "FLT":I%=&0E000110: Format5 "FIX":I%=&0E100110: Format6 "WFS":I%=&0E200110: Format7 "RFS":I%=&0E300110: Format7 "WFC":I%=&0E400110: Format7 "RFC":I%=&0E500110: Format7 200,"" FPAssem(I%,Inst$): ********************************************************************* * Here we process a format 1 instruction * * (Format 1) Unary ops -- op<cond>prec<round> Fd,{Fm|#val} * ********************************************************************* Format1 JAS%+=3:I%+= Cond+ Prec1+ Round1 : insert opcode modifiers. Inst$,S%,1)<>" " 202,"" Deblank=0 S%-=1 213,"" : scan past excess blanks. MGI%+=( FPReg)<<12 : insert destination register. T%<>1 201,"" Inst$,S%+1,1)="#" I%+= Literal I%+= FPReg T%>0 201,"" ********************************************************************* * Here we process a format 2 instruction * * (Format 2) Binary ops -- op<cond>prec<round> Fd,Fn,{Fm|#val} * ********************************************************************* Format2 WAS%+=3:I%+= Cond+ Prec1+ Round1 : insert opcode modifiers. Inst$,S%,1)<>" " 202,"" Deblank=0 S%-=1 213,"" : scan past excess blanks. ZGI%+=( FPReg)<<12 : insert destination register. T%<>1 201,"" \?I%+=( FPReg)<<16 : insert LHS register. T%<>1 201,"" Inst$,S%+1,1)="#" I%+= Literal I%+= FPReg T%>0 201,"" ********************************************************************* * Here we process a format 3 instruction * * (Format 3) Data transfer ops -- op<cond>prec Fd,addr * ********************************************************************* Format3 fBS%+=3:I%+= Cond+ Prec3 : insert opcode modifiers. Inst$,S%,1)<>" " 202,"" Deblank=0 S%-=1 213,"" : scan past excess blanks. iGI%+=( FPReg)<<12 : insert destination register. T%<>1 201,"" Inst$,S%+1,1)="[" ******************************************************************* * Here we handle an explicit address- [Rn,#Off]<!> or [Rn]<,#Off> * ******************************************************************* o@ S%+=1:I%+=( GPReg)<<16 : insert base register. T%<1 204,"" T%=2 rK ***************************************************************** sK * Only one parameter in the brackets - post-indexed mode. * tK ***************************************************************** u> S%+=1 : step past the "]". Inst$,S%,1) wF " ":I%+=&00800000 : insert post-indexed offset 0. xC ",":I%+= Offset : insert post-indexed offset. 205,"" T%>0 201,"" { }K ***************************************************************** ~K * Multiple parameters in the brackets - pre-indexed mode. * K ***************************************************************** E I%+= Offset+&01000000 : insert pre-indexed offset. T%<>2 204,"" Inst$,S%+1,1) E " ": all done if blank after "]". ? "!": I%+=&00200000 : insert Writeback flag. 206,"" ******************************************************************* * Here we handle a label expression. The user must ensure that * * the net relocatability is 1; we have no way of checking it. * ******************************************************************* H I%+=&010F0000 : use R15 as pre-indexed base. & Z%=S%+1: Dlimiter>0 201,"" * J%=( Inst$,Z%,S%-Z%)))-(P%+8))/4 (J%)>255 207,"" J%<0 I%+= (J%) I%+=J%+&00800000 ********************************************************************* * Here we process a format 4 instruction * * We enter having recognised the basic opcode - CMF or CNF. First * * we test if the opcode has the exception modifier (CMFE or CNFE) * * and adjust the instruction skeleton accordingly. * * (Format 4) Status transfer ops -- op<cond> Fn,{Fm|#val} * ********************************************************************* Format4 Inst$,S%+3,1)="E" Inst$,S%+4,1)<>"Q" I%+=&00400000:S%+=4 S%+=3 CI%+= Cond : insert opcode modifiers. Inst$,S%,1)<>" " 202,"" Deblank=0 S%-=1 213,"" : scan past excess blanks. ?I%+=( FPReg)<<16 : insert LHS register. T%<>1 201,"" Inst$,S%+1,1)="#" I%+= Literal I%+= FPReg T%>0 201,"" ********************************************************************* * Here we process a format 5 instruction * * (Format 5) GP reg xfr -- op<cond>prec<round> Fn,Rd * ********************************************************************* Format5 AS%+=3:I%+= Cond+ Prec1+ Round1 : insert opcode modifiers. Inst$,S%,1)<>" " 202,"" Deblank=0 S%-=1 213,"" : scan past excess blanks. GI%+=( FPReg)<<16 : insert destination register. T%<>1 201,"" GPReg<<12 T%>0 201,"" ********************************************************************* * Here we process a format 6 instruction * * (Format 6) GP reg xfr -- op<cond>prec<round> Rd,Fm * ********************************************************************* Format6 AS%+=3:I%+= Cond+ Prec1+ Round1 : insert opcode modifiers. Inst$,S%,1)<>" " 202,"" Deblank=0 S%-=1 213,"" : scan past excess blanks. GI%+=( GPReg)<<12 : insert destination register. T%<>1 201,"" BI%+= FPReg : insert source register. T%>0 201,"" ********************************************************************* * Here we process a format 7 instruction * * (Format 7) GP reg xfr -- op<cond> Rd * ********************************************************************* Format7 CS%+=3:I%+= Cond : insert opcode modifiers. Inst$,S%,1)<>" " 202,"" Deblank=0 S%-=1 213,"" : scan past excess blanks. GI%+=( GPReg)<<12 : insert destination register. T%>0 201,"" ********************************************************************* * Here we scan the instruction string for the next non-blank. * * At entry S% points to the current character, updated at exit. * * The function sets a completion code - * * 0 - positioned at non-blank -1 - no non-blank found * ********************************************************************* Deblank S%=S% (Inst$) Inst$,S%,1)<>" " ********************************************************************* * Here we scan the instruction string for the next delimiter. * * At entry S% points to the leading delimiter, updated at exit. * * The function sets a completion code identifying the delimiter - * * 0 - blank 1 - comma 2 - right bracket -1 - none found * ********************************************************************* Dlimiter S%=S%+1 (Inst$) Inst$,S%,1) " ":=0 ",":=1 "]":=2 ********************************************************************* * Here we evaluate the next operand as a general purpose register. * ********************************************************************* GPReg FZ%=S%+1:T%= Dlimiter : scan out the base register. Inst$,Z%,S%-Z%)) : evaluate register number. J%<0 J%>15 203,"" ********************************************************************* * Here we evaluate the next operand as a floating point register. * ********************************************************************* FPReg *Z%=S%+1: T%= Dlimiter: T%>1 201,"" Inst$,Z%,S%-Z%)) : evaluate register number. J%<0 J%>7 208,"" ********************************************************************* * Here we evaluate the next operand as an offset from a base reg. * ********************************************************************* Offset Inst$,S%+1,1)<>"#" 205,"" ,Z%=S%+2: T%= Dlimiter: T%=1 201,"" Inst$,Z%,S%-Z%))/4 (J%)>255 207,"" J%<0 (J%) =J%+&00800000 ********************************************************************* * Here we evaluate the next operand as a literal value. * ********************************************************************* Literal ,Z%=S%+2: T%= Dlimiter: T%>0 201,"" Inst$,Z%,S%-Z%)) 0.5:=&0000000E 0:=&00000008 1:=&00000009 2:=&0000000A 3:=&0000000B 4:=&0000000C 5:=&0000000D 10:=&0000000F 209,"" ********************************************************************* * Here we process the execution condition for the instruction. * ********************************************************************* Inst$,S%,2) "EQ":S%+=2:=&00000000 "NE":S%+=2:=&10000000 "CS":S%+=2:=&20000000 "CC":S%+=2:=&30000000 "MI":S%+=2:=&40000000 "PL":S%+=2:=&50000000 "VS":S%+=2:=&60000000 "VC":S%+=2:=&70000000 "HI":S%+=2:=&80000000 "LS":S%+=2:=&90000000 "GE":S%+=2:=&A0000000 "LT":S%+=2:=&B0000000 "GT":S%+=2:=&C0000000 "LE":S%+=2:=&D0000000 "AL":S%+=2:=&E0000000 "NV":S%+=2:=&F0000000 =&E0000000 : must be precision/round. ********************************************************************* * Here we process precision for format 1,2,5,6,7 (set in bits 19,7) * ********************************************************************* Prec1 Inst$,S%,1) "S":S%+=1:=&00000000 "D":S%+=1:=&00000080 "E":S%+=1:=&00080000 210,"" ********************************************************************* * Here we process precision for format 3 (set in bits 22,15) * ********************************************************************* Prec3 Inst$,S%,1) "S":S%+=1:=&00000000 "D":S%+=1:=&00008000 "E":S%+=1:=&00400000 "P":S%+=1:=&00408000 210,"" ********************************************************************* * Here we process rounding for format 1 and 2 (flags in bits 6,5) * ********************************************************************* Round1 Inst$,S%,1) " ":=&00000000 "P":S%+=1:=&00000020 "M":S%+=1:=&00000040 "Z":S%+=1:=&00000060 211,"" ********************************************************************* * Here we output the assembled instruction or constant. * * The options selected in Pass% direct the output and any listing. * * Output is always directed to storage at a 4-byte boundary, the * * location counters being adjusted beforehand if necessary. * * * * Parameter I% is the 4-byte word to be output to the code space * * at the current location counter. * * * * Parameter I$ is a string to be printed in the operation code * * field of the output listing. (This is generally * * the instruction string that has been processed.) * * * * The function destroys static variable Z% * ********************************************************************* FPAssem(I%,I$) Z%=P% Z%<>0 UG Z%=4-Z% : find adjustment factor. VC P%+=Z%: (Pass% O%+=Z% : align to 4-byte boundary. (Pass% "00000000"+ ~(P%),8);" "; "00000000"+ ~(I%),8);" +++++++++ ";I$ (Pass% ******************************************************************* * Output the assembled word in offset assembly mode. * ******************************************************************* ]J !(O%)=I% : output the assembled word. ^I O%+=4:P%+=4 : update location counters. ******************************************************************* * Output the assembled word in direct assembly mode. * ******************************************************************* cJ !(P%)=I% : output the assembled word. dH P%+=4 : update location counter. ********************************************************************* * Here we log out trapped assembly errors * ********************************************************************* FPError Msg$ 200: Msg$="Error 200: Invalid Opcode" 201: Msg$="Error 201: Invalid delimiter" 202: Msg$="Error 202: Unexpected opcode modifier" 203: Msg$="Error 203: Invalid general register" 204: Msg$="Error 204: Invalid address reference" 205: Msg$="Error 205: Invalid offset field" 206: Msg$="Error 206: Invalid writeback flag" 207: Msg$="Error 207: Invalid offset value" 208: Msg$="Error 208: Invalid floating point register" 209: Msg$="Error 209: Invalid literal value" 210: Msg$="Error 210: Invalid precision specification" 211: Msg$="Error 211: Invalid rounding specification" 212: Msg$="Error 212: No Opcode found" 213: Msg$="Error 213: No Operands found" 220: Msg$="Error 220: Short float conversion underflow" " at line "; (Pass% Msg$ ********************************************************************* * FLOATING POINT CONSTANT ASSEMBLY FUNCTION * * * * (C) Copyright K G Robbins 14 June 1988 * * * * This function accepts a floating point number in ARM Basic * * format and maps it into IEEE single-length format. The actual * * parameter may be entered as a literal or as an expression; this * * will be evaluated by the Basic interpreter before presentation * * as the formal parameter. * * * * The function expects a valid assembler pass number in global * * integer variable Pass% * * * * The function destroys static variables I%, J%, S% * ********************************************************************* equfS(K) FPError: FPAssem(-1,""): =0 (Pass% S%=O% S%=P% : use output area as worksp. ********************************************************************* * We use the code space as a workspace to remap the input number. * ********************************************************************* E|(S%+4)=K : pick up the argument. FI%=!(S%+4) : pick up ARMB mantissa. FJ%=?(S%+8) : pick up ARMB exponent. J%<>0 I%<>0 I I%=(I% >> 8) &807FFFFF : cnvt ARMB mantissa to IEEE. K J%+=(127-128-1) : cnvt ARMB exponent to IEEE. J%<=0 220,"" : would be a NAN. H I%+=(J%<<23) : build IEEE float number. FPAssem(I%,"EQUFS "+ (K)): ********************************************************************* * FLOATING POINT CONSTANT ASSEMBLY FUNCTION * * * * (C) Copyright K G Robbins 14 June 1988 * * * * This function accepts a floating point number in ARM Basic * * format and maps it into IEEE double-length format. The actual * * parameter may be entered as a literal or as an expression; this * * will be evaluated by the Basic interpreter before presentation * * as the formal parameter. * * * * The function expects a valid assembler pass number in global * * integer variable Pass% * * * * The function destroys static variables I%, J%, S% * ********************************************************************* equfD(K) FPError: FPAssem(-1,""): FPAssem(-1,""): =0 (Pass% S%=O% S%=P% : use output area as worksp. ********************************************************************* * We use the code space as a workspace to remap the input number. * ********************************************************************* E|(S%+4)=K : pick up the argument. FI%=!(S%+4) : pick up ARMB mantissa. FJ%=?(S%+8) : pick up ARMB exponent. J%<>0 I%<>0 I I%=(I% >> 11) &800FFFFF : cnvt ARMB mantissa to IEEE. K J%+=(1023-128-1) : cnvt ARMB exponent to IEEE. H I%+=(J%<<20) : build IEEE float number. J J%=(!(S%+4) << 21) : align residue of mantissa. FPAssem(I%,"EQUFD "+ (K)): FPAssem(J%,""):